home *** CD-ROM | disk | FTP | other *** search
/ Aminet 46 / Aminet 46 (2001)(GTI - Schatztruhe)[!][Dec 2001].iso / Aminet / text / edit / edt10src.lha / txt / Kernel.mod < prev    next >
Text File  |  1995-03-20  |  7KB  |  331 lines
  1. (*
  2.   .name       Kernel
  3.   .task       core instructions
  4.   .release    1.0
  5.   .language   Oberon-2
  6.   .translator Amiga Oberon 3.11
  7.   .system     AmigaOS 2.04/2.1/3.0
  8.   .author     Joachim Barheine
  9.   .address    Hochgrevestraße 3, D-38640 Goslar
  10.   .copyright  (c) 1994 by Joachim Barheine
  11. *)
  12.  
  13. (* .info: 29/09/94, 12:51:17, version 26 *)
  14.  
  15. (* $TypeChk- *)
  16.  
  17. MODULE Kernel;  (* $JOIN KernelAsm.o *)
  18.  
  19. IMPORT
  20.   SYS:= SYSTEM,
  21.  
  22.   ASL,
  23.   Dos,
  24.   Err:= ErrCodes,
  25.   Exec,
  26.   GadTools,
  27.   Graphics,
  28.   I:= Intuition,
  29.   IFFParse,
  30.   RexxSysLib,
  31.   Util:= Utility;
  32.  
  33. CONST
  34.   undef* = -1;  (* undefined parameter value *)
  35.  
  36.   (* result codes *)
  37.   rcOk* = 0;
  38.   rcWarn* = 5;
  39.   rcImportantNotFound* = 12;
  40.   rcIllegal* = 15;
  41.   rcAborted* = 20;
  42.  
  43. (* $IF M2Amiga THEN *)
  44.   alertRaw= "---M2Edt failed: error #%lx\x00\x00";
  45.   alertLib= "---M2Edt failed: missing %s\x00\x00";
  46.   version= "\o$VER: M2Edt 1.0 (20.3.94)";
  47. (* $ELSE *)
  48.   alertRaw= "---Edt failed: error #%lx\x00\x00";
  49.   alertLib= "---Edt failed: missing %s\x00\x00";
  50.   version= "\o$VER: Edt 1.0 (20.3.94)";
  51. (* $END *)
  52.  
  53. TYPE
  54.   ANY* = UNTRACED POINTER TO ANYDesc;
  55.   ANYDesc* = RECORD END;
  56.  
  57.   Data= UNTRACED POINTER TO ARRAY OF ANY;
  58.  
  59.   DynArray* = RECORD
  60.     array: Data;
  61.     len-, step- : INTEGER;
  62.   END;
  63.  
  64.   DynString* = UNTRACED POINTER TO ARRAY OF CHAR;
  65.  
  66. VAR
  67.   execVer- , intVer- , aslVer- , gfxVer- , gtVer- : INTEGER;
  68.   memAlert*: BOOLEAN;   (* very few memory *)
  69.  
  70. (* -- dynamic arrays -- *)
  71.  
  72. PROCEDURE (v: ANY) Dispose* ;
  73. END Dispose;
  74.  
  75. PROCEDURE (VAR a: DynArray) Extend(len: INTEGER);
  76.  
  77. VAR
  78.   old: Data;
  79.   i: INTEGER;
  80.  
  81. BEGIN
  82.   old:= a.array;
  83.   NEW(a.array, len);
  84.   FOR i:= 0 TO SHORT(LEN(old^) - 1) DO  a.array[i]:= old[i] END;
  85.   FOR i:= SHORT(LEN(old^)) TO len - 1 DO a.array[i]:= NIL END;
  86.   DISPOSE(old);
  87. END Extend;
  88.  
  89. PROCEDURE (VAR a: DynArray) New* (len, step: INTEGER);
  90.  
  91. VAR
  92.   i: INTEGER;
  93.  
  94. BEGIN
  95.   NEW(a.array, len);
  96.   FOR i:= 0 TO len - 1 DO a.array[i]:= NIL END;
  97.   a.len:= 0;
  98.   a.step:= step;
  99. END New;
  100.  
  101. PROCEDURE (VAR a: DynArray) Dispose* ;
  102.  
  103. VAR
  104.   i: INTEGER;
  105.  
  106. BEGIN
  107.   FOR i:= 0 TO SHORT(LEN(a.array^) - 1) DO
  108.     IF a.array[i] # NIL THEN
  109.       a.array[i].Dispose;
  110.       DISPOSE(a.array[i]);
  111.     END;
  112.   END;
  113.   DISPOSE(a.array);
  114. END Dispose;
  115.  
  116. PROCEDURE (VAR a: DynArray) Put* (x: ANY; i: INTEGER);
  117.  
  118. BEGIN
  119.   IF i >= LEN(a.array^) THEN
  120.     a.Extend(i + a.step);
  121.   ELSIF a.array[i] # NIL THEN
  122.     a.array[i].Dispose;
  123.     DISPOSE(a.array[i]);
  124.   END;
  125.   a.array[i]:= x;
  126.   IF i >= a.len THEN a.len:= i + 1 END;
  127. END Put;
  128.  
  129. PROCEDURE (VAR a: DynArray) Delete* (i: INTEGER);
  130.  
  131. BEGIN
  132.   a.Put(NIL, i);
  133. END Delete;
  134.  
  135. PROCEDURE (VAR a: DynArray) Get* (i: INTEGER): ANY;
  136.  
  137. BEGIN
  138.   RETURN a.array[i];
  139. END Get;
  140.  
  141. (* -- byte stream functions -- *)
  142.  
  143. PROCEDURE Read* (s: ARRAY OF SYS.BYTE; VAR pos: LONGINT;
  144.                  VAR dest: ARRAY OF SYS.BYTE): BOOLEAN;
  145.  
  146. VAR
  147.   i: LONGINT;
  148.  
  149. (* $CopyArrays- *)
  150.  
  151. BEGIN
  152.   IF LEN(s) >= pos + LEN(dest) THEN
  153.     FOR i:= 0 TO LEN(dest)-1 DO dest[i]:= s[pos]; INC(pos) END;
  154.     RETURN TRUE;
  155.   ELSE
  156.     RETURN FALSE;
  157.   END;
  158. END Read;
  159.  
  160. PROCEDURE Match* (VAR s: ARRAY OF SYS.BYTE; VAR pos: LONGINT;
  161.                   data: ARRAY OF SYS.BYTE): BOOLEAN;
  162.  
  163. (* $CopyArrays- *)
  164.  
  165. VAR
  166.   i: LONGINT;
  167.  
  168. BEGIN
  169.   IF LEN(s) >= pos + LEN(data) THEN
  170.     FOR i:= 0 TO LEN(data)-1 DO
  171.       IF data[i] # s[pos] THEN
  172.         DEC(pos, i);
  173.         RETURN FALSE;
  174.       ELSE
  175.         INC(pos);
  176.       END;
  177.     END;
  178.     RETURN TRUE;
  179.   ELSE
  180.     RETURN FALSE;
  181.   END;
  182. END Match;
  183.  
  184. PROCEDURE MatchIC* (VAR s: ARRAY OF CHAR; VAR pos: LONGINT;
  185.                     keyword: ARRAY OF CHAR): BOOLEAN;
  186.  
  187. (* $CopyArrays- *)
  188.  
  189. VAR
  190.   i: LONGINT;
  191.  
  192. BEGIN
  193.   IF LEN(s) > pos + LEN(keyword) THEN
  194.     i:= 0;
  195.     WHILE keyword[i] # 0X DO
  196.       IF keyword[i] # Util.ToUpper(s[pos]) THEN
  197.         DEC(pos, i);
  198.         RETURN FALSE;
  199.       ELSE
  200.         INC(i); INC(pos);
  201.       END;
  202.     END;
  203.     RETURN TRUE;
  204.   ELSE
  205.     RETURN FALSE;
  206.   END;
  207. END MatchIC;
  208.  
  209. PROCEDURE ReadInt* (VAR s: ARRAY OF CHAR; VAR pos: LONGINT; VAR val: LONGINT): BOOLEAN;
  210.  
  211. VAR
  212.   p0: LONGINT;
  213.  
  214. BEGIN
  215.   p0:= pos;
  216.   val:= 0;
  217.   WHILE (s[pos] >= "0") & (s[pos] <= "9") DO
  218.     val:= 10 * val + ORD(s[pos]) - ORD("0");
  219.     INC(pos);
  220.   END;
  221.   RETURN pos > p0;
  222. END ReadInt;
  223.  
  224. (* -- misc -- *)
  225.  
  226. (* make a <= x <= b *)
  227. PROCEDURE ClipL* (VAR x: LONGINT; a, b: LONGINT);
  228.  
  229. BEGIN
  230.   IF x < a THEN x:= a ELSIF x > b THEN x:= b END;
  231. END ClipL;
  232.  
  233. (* make a <= x <= b *)
  234. PROCEDURE ClipI* (VAR x: INTEGER; a, b: INTEGER);
  235.  
  236. BEGIN
  237.   IF x < a THEN x:= a ELSIF x > b THEN x:= b END;
  238. END ClipI;
  239.  
  240. (* make a <= b *)
  241. PROCEDURE SortL* {"KernelAsm.SortL"}(VAR a{8}, b{9}: LONGINT);
  242.  
  243. (* make a <= b *)
  244. PROCEDURE SortI* {"KernelAsm.SortI"}(VAR a{8}, b{9}: INTEGER);
  245.  
  246. PROCEDURE* PutCh {"KernelAsm.PutCh"};
  247.  
  248. (* format a C-style string *)
  249. PROCEDURE FormatString* (VAR dest: ARRAY OF CHAR; fmt: ARRAY OF CHAR;
  250.                          param: ARRAY OF LONGINT);
  251.  
  252. (* $CopyArrays- *)
  253.  
  254. BEGIN
  255.   Exec.OldRawDoFmt(fmt, SYS.ADR(param), PutCh, SYS.ADR(dest));
  256. END FormatString;
  257.  
  258. (* convert integer to string *)
  259. PROCEDURE IntToStr* (VAR str: ARRAY OF CHAR; int: LONGINT);
  260.  
  261. VAR
  262.   args: ARRAY 1 OF LONGINT;
  263.  
  264. BEGIN
  265.   args[0]:= int;
  266.   FormatString(str, "%ld", args);
  267. END IntToStr;
  268.  
  269. PROCEDURE Alert(template: ARRAY OF CHAR; arg: LONGINT);
  270.  
  271. VAR
  272.   alertStr: ARRAY 120 OF CHAR;
  273.   a: ARRAY 1 OF LONGINT;
  274.  
  275. (* $CopyArrays- *)
  276.  
  277. BEGIN
  278.   a[0]:= arg;
  279.   FormatString(alertStr, template, a);
  280.   alertStr[0]:= 00X; alertStr[1]:= 0EX; alertStr[2]:= 14X;
  281.   IF I.DisplayAlert(I.recoveryAlert, alertStr, 35) THEN END;
  282.   HALT(Dos.fail);
  283. END Alert;
  284.  
  285. (* report failure and abort program if 'cond' # TRUE (alert) *)
  286. PROCEDURE Assert* (cond: BOOLEAN; code: LONGINT);
  287.  
  288. BEGIN
  289.   IF ~cond THEN Alert(alertRaw, code) END;
  290. END Assert;
  291.  
  292. (* report failure and abort program if cond # TRUE (alert) *)
  293. PROCEDURE AssertLib(lib: Exec.LibraryPtr; libName: ARRAY OF CHAR);
  294.  
  295. (* $CopyArrays- *)
  296.  
  297. BEGIN
  298.   IF lib = NIL THEN Alert(alertLib, SYS.ADR(libName)) END;
  299. END AssertLib;
  300.  
  301. PROCEDURE FastCopy {"KernelAsm.Copy"} (from{8}: ARRAY OF CHAR; i0{1}: LONGINT;
  302.                                        VAR to{9}: ARRAY OF CHAR; i1{2}: LONGINT;
  303.                                        len{0}: LONGINT);
  304.  
  305. PROCEDURE Copy* (from: ARRAY OF CHAR; i0: LONGINT;
  306.                  VAR to: ARRAY OF CHAR; i1: LONGINT;
  307.                  len: LONGINT);
  308.  
  309. (* $CopyArrays- *)
  310.  
  311. BEGIN
  312.   Assert((i0 >= 0) & (i0 + len <= LEN(from)) & (i1 >= 0) & (i1 + len <= LEN(to)),
  313.          Err.kernelCopy);
  314.   FastCopy(from, i0, to, i1, len);
  315. END Copy;
  316.  
  317. (* MAIN *)
  318.  
  319. BEGIN
  320.   SYS.SETREG(0, SYS.ADR(version));
  321.   execVer:= Exec.exec.libNode.version;
  322.   Assert(execVer >= 37, Err.kernelNoOS);
  323.   AssertLib(ASL.base, "asl.library");
  324.   aslVer:= ASL.base.version;
  325.   AssertLib(IFFParse.base, "iffparse.library");
  326.   AssertLib(RexxSysLib.base, "rexxsyslib.library");
  327.   intVer:= I.int.libNode.version;
  328.   gfxVer:= Graphics.gfx.libNode.version;
  329.   gtVer:= GadTools.base.version;
  330.   memAlert:= Exec.AvailMem(LONGSET{}) < 64 * 1024;
  331. END Kernel.